Mac Mania 2/MacMania 2.toast/Demo's/Tools&Utilities/Programming/MacStarter Pascal 1.0/xWindows definition files/TextReader.p

Text File | 1993-06-12 | 11.1 KB | 370 lines | [TEXT/PJMM]

unit TextReader;

interface

uses
    xWindow, xTextWindow;

const
    maxWordLength = 31;
    endOfData = chr(255);
    endOfLine = chr(13);
    tab = chr(9);
    space = ' ';
    badReal = 1e2001;

type

    WordString = string[maxWordLength];

    Position = longint;

    TextReader = object

      { THE FOLLOWING VARIABLES can be changed to control the behavior of the }
      { text reader. }

            whiteSpaceChars: set of char;  { set of chars that SkipWhiteSpace will skip over. }
                  { Default value, after call to setup procedure, is [space,tab,endOfLine]. }
            wordChars: set of char;  { set of chars that ReadWord will allow in a word }
                  { Default value, after call to setup procedure, is ['a'..'z','A'..'Z']. }
            discardExtraWordChars: boolean;  { if a word encountered by ReadWord is longer }
                  { than MaxWordLength, this variable controls whether the extra chars are}
                  { read and discarded or left there to be read later (by next ReadWord call, e.g. ) }
            convertWordsToLowerCase: boolean; { if true, ReadWords converts uppercase letters }
                  { in the word it reads to lower case }
            commentStart: char;  { if the value of commentStart is NOT a space, then SkipWhiteSpace }
                  { will skip over comments, as well as any chars in whiteSpaceChars.  The }
                  { comment ends when the endOfData is reached or when the commentEnd char }
                  { is encountered.  Default value is a space. }
            commentEnd: char;  { Default value is endOfLine }

     { VARIABLES YOU CAN LOOK AT BUT NOT CHANGE }

            numError: boolean;   { After a call to ReadInteger or ReadReal, this is set to TRUE }
                  { if a number has been successfully read, and to FALSE otherwise }
            errorPosition: Position;   { whenever numError is set to TRUE, errorPosition }
                  { to the current position in the text being read. }

      { VARIABLES YOU SHOULD'T MESS WITH }

            theTextWin: xTextWindow;
            theText: CharsHandle;
            theTextSize: integer;
            thePos: Position;
            fromString: boolean;

            procedure SetUp (chars: CharsHandle;
                                        size: longint);
         { Installs text to be read by the text reader; size tells how many chars there are, }
         { and might be, for example, GetHandleSize(Handle(chars)).  Also sets the text}
         { reader to begin reading at the beginning of the text, and assigns default values }
         { to whiteSpaceChars, commentStart, etc. }
            procedure SetupFromTextWindow (win: xTextWindow);
         { Like SetUp, but uses the text from the xTextWindow.  (Text should not be edited }
         { while reader is reading. If editing might have occured, call Reset.) }
            procedure SetupFromString (str: string);
         { Like SetUp, but instals a COPY of the string to be read by the read. }
            procedure DisposeStringData;
         { SetUpFromString allocates a CharsHandle to store the copy of the contents of }
         { the string; after reading, call this to dispose of that CharsHandle.  If you just }
         { call another SetUp proc, the handle will NOT be disposed, and the space it }
         { occupies is lost. }
            procedure reset;
         { Start reading from beginning again. (Set reading position to 0, but also check }
         { for changes in size of text, if text comes from an xTextWindow. }
            procedure setPosition (pos: Position);
         { sets reading position in text}
            procedure skipWhiteSpace;
         { reads and discards any chars in the set whiteSpaceChars; also read past comments }
         { is commentStart is not a space. }
            procedure readChar (var ch: char);
         { reads and returns next char in text; if there are no more chars, endOfData is returned }
            procedure readWord (var word: WordString);
         { SKIPS TO NEXT CHAR in the set wordChars, then reads a sequence of chars in }
         { wordChars and returns it in the parameter words.  If endOfData is encountered}
         { while skipping junk, an empty string is returned.  A maximum of maxWordLength }
         { chars will be returned in word; if more are found, result depends on value of }
         { discardExtraWordChars .   If convertWords ToLowerCase is true, any uppercase }
         { chars word are converted to lower case. }
            procedure readInteger (var n: longint);
         { calls SkipWhiteSpace, then tries to read an integer.  If a legal integer is read, it }
         { is returned and numError is set to FALSE.  If not, then numError is set to TRUE, }
         { errorPosition is set to the position in the text where error was found, and a }
         { value of + or - maxlongint will be returned.  Note:  If number starts with a }
         { + or - sign, spaces and tabs between the sign and the first digit will be allowed.) }
            procedure readReal (var x: extended);
         { Just like readInteger, but reads a real number.  Exponents allowed, but not }
         { more than three digits are allowed in the exponent.  If an error occurs, the }
         { value returned will be badReal. }
            function GetChar: char;
         { ReadChar as a function }
            function moreChars: boolean;
         { tests if there are any more chars in the text still to be read. }
            function next: char;
         { returns next char without reading it (i.e. tells you what the next char }
         { returned by readChar or GetChar would be);  can return endOfData. }
            function where: Position;
         { returns current position in text }
        end;

implementation

procedure TextReader.Setup (chars: charsHandle;
                                size: longint);
    begin
        theText := chars;
        theTextSize := size;
        theTextWin := nil;
        thePos := 0;
        commentStart := ' ';
        commentEnd := endOfLine;
        whiteSpaceChars := [space, tab, endOfLine];
        wordChars := ['a'..'z', 'A'..'Z'];
        discardExtraWordChars := true;
        convertWordsToLowerCase := false;
        fromString := false;
        numError := false;
    end;

procedure TextReader.SetupFromTextWindow (win: xTextWindow);
    begin
        Setup(nil, 0);
        theText := CharsHandle(win.TE^^.hText);
        theTextSize := win.TE^^.teLength;
        theTextWin := win;
    end;

procedure TextReader.SetUpFromString (str: string);
    var
        i: integer;
    begin
        Setup(nil, 0);
        theText := CharsHandle(NewHandle(length(str)));
        theTextSize := length(str);
        for i := 1 to length(str) do
            theText^^[i - 1] := str[i];
        fromString := true;
    end;

procedure TextReader.DisposeStringData;
    begin
        if fromString then begin
                DisposHandle(Handle(theText));
                theText := nil;
                theTextSize := 0;
                thePos := 0;
                fromString := false;
            end;
    end;

procedure TextReader.reset;
    begin
        if theTextWin <> nil then
            theTextSize := theTextWin.TE^^.teLength;
        thePos := 0;
    end;

procedure TextReader.setPosition (pos: Position);
    begin
        thePos := pos;
        if pos < 0 then
            Pos := 0
        else if pos > theTextSize then
            pos := theTextSize;
    end;

procedure TextReader.skipWhiteSpace;
    begin
        while (thePos < theTextSize) & ((theText^^[thePos] in whiteSpaceChars) | (theText^^[thePos] = commentStart)) do
            if (commentStart <> space) & (theText^^[thePos] = commentStart) then begin
                    repeat
                        thePos := thePos + 1
                    until (thePos = theTextSize) | (theText^^[thePos] = commentEnd);
                    if thePos < theTextSize then
                        thePos := thePos + 1;
                end
            else
                thePos := thePos + 1;
    end;

procedure TextReader.readChar (var ch: char);
    begin
        if thePos >= theTextSize then
            ch := endOfData
        else begin
                ch := theText^^[thePos];
                thePos := thePos + 1;
            end;
    end;

procedure TextReader.readWord (var word: WordString);
    var
        ch: char;
        i: integer;
    begin
        while not (next in wordChars) do
            thePos := thePos + 1;
        if thePos >= theTextSize then
            word := ''
        else begin
                word := '';
                ch := next;
                while (ch in wordChars) & (length(word) < maxWordLength) do begin
                        ReadChar(ch);
                        word := Concat(word, ch);
                        ch := next;
                    end;
                if discardExtraWordChars then
                    while ch in wordChars do begin
                            readChar(ch);
                            ch := next;
                        end;
                if convertWordsToLowerCase then begin
                        for i := 1 to length(word) do
                            if word[i] in ['A'..'Z'] then
                                word[i] := chr(ord(word[i]) - ord('A') + ord('a'));
                    end;
            end;
    end;

procedure TextReader.readInteger (var n: longint);
    var
        neg: boolean;
        ch: char;
        digit: longint;
    begin
        SkipWhiteSpace;
        numError := false;
        neg := next = '-';
        if (next = '-') | (next = '+') then begin
                thePos := thePos + 1;
                while (thePos < theTextSize) & ((theText^^[thePos] = space) | (theText^^[thePos] = tab)) do
                    thePos := thePos + 1;
            end;
        if not (next in ['0'..'9']) then begin
                numError := true;
                errorPosition := thePos;
                n := maxlongint;
            end
        else begin
                n := 0;
                ch := next;
                while ch in ['0'..'9'] do begin
                        ch := GetChar;
                        digit := ord(ch) - ord('0');
                        if n > (maxlongint - digit) div 10 then begin
                                n := maxlongint;
                                numError := true;
                                errorPosition := thePos;
                                leave;
                            end
                        else
                            n := 10 * n + digit;
                        ch := next;
                    end;
            end;
        if neg then
            n := -n;
    end;

procedure TextReader.readReal (var x: extended);
    var
        s: string;
        ch: char;
        ct: integer;
        neg: boolean;
    begin
        SkipWhiteSpace;
        numError := false;
        neg := next = '-';
        if (next = '-') | (next = '+') then begin
                thePos := thePos + 1;
                while (thePos < theTextSize) & ((theText^^[thePos] = space) | (theText^^[thePos] = tab)) do
                    thePos := thePos + 1;
            end;
        if not (next in ['0'..'9', '.']) then begin
                numError := true;
                errorPosition := thePos;
                x := badReal;
                EXIT(readReal);
            end;
        s := '';
        ct := 0;
        while (next in ['0'..'9']) & (length(s) < 255) do
            s := Concat(s, GetChar);
        if (next = '.') & (length(s) < 255) then begin
                s := Concat(s, GetChar);
                while (next in ['0'..'9']) & (length(s) < 255) do
                    s := Concat(s, GetChar);
            end;
        if (next in ['e', 'E']) & (length(s) < 255) then begin
                if s = '.' then begin
                        numError := true;
                        errorPosition := thePos;
                        x := badReal;
                        EXIT(readReal);
                    end;
                s := Concat(s, GetChar);
                if (next in ['+', '-']) & (length(s) < 255) then
                    s := Concat(s, GetChar);
                if not (next in ['0'..'9']) then begin
                        numError := true;
                        errorPosition := thePos;
                        x := badReal;
                        EXIT(readReal);
                    end;
                while (next in ['0'..'9']) & (length(s) < 255) do begin
                        s := Concat(s, GetChar);
                        ct := ct + 1;
                        if ct > 3 then begin
                                numError := true;
                                errorPosition := thePos;
                                x := badReal;
                                EXIT(readReal);
                            end;
                    end;
            end;
        IOCheck(false);
        ReadString(s, x);
        IOCheck(true);
        if IOResult <> noErr then begin
                numError := true;
                errorPosition := thePos;
                x := badReal;
                EXIT(readReal);
            end;
        if neg then
            x := -x;
    end;

function TextReader.GetChar: char;
    begin
        if thePos >= theTextSize then
            GetChar := endOfData
        else begin
                GetChar := theText^^[thePos];
                thePos := thePos + 1;
            end;
    end;

function TextReader.moreChars: boolean;
    begin
        moreChars := thePos < theTextSize;
    end;

function TextReader.next: char;
    begin
        if thePos >= theTextSize then
            next := endOfData
        else
            next := theText^^[thePos];
    end;

function TextReader.where: Position;
    begin
        where := thePos;
    end;


end.